perm filename DREDIT.F4[MSS,LCS]4 blob
sn#102005 filedate 1974-05-12 generic text, type T, neo UTF8
00100 SUBROUTINE DREDIT
00200 COMMON/ED/K,NEXT,NN,NX,NY,J
00300 COMMON /RZ/RSZ,IPLT,RJB,CENTR
00400 COMMON /RC/MCLEF(400),IST(4000)
00500 COMMON/ZN/SCLEF(400,2),N
00600 COMMON/LL/LL
00700 CC COMMON/JJJ/JJJ
00800 EQUIVALENCE(M,SCLEF(1,2)),(KK,SCLEF(1,1))
00900 NEXTX=NEXT-1
01400 J=MCLEF(1)
01500 20 IF(K.EQ.'D')GO TO 1
01600 C MOVE CURSOR TO INSERT POINT, TYPE CR.
01700 9 FORMAT(' SET POINT ',$)
01800 CC IF(JJJ.AND.JJK)GO TO 131
01900 C FOR CONTINUING RELATIVE CHANGE
02000 CC IF(JJJ.EQ.0)JJK=0
02100 5 TYPE 9
02200 ACCEPT 3,L
02210
02300 IF(L.EQ.'B'.OR.L.EQ.'N')RETURN
02400 C N OR B=BACKUP, J=INSERT OR ALTER TO JUMP, C=ALTER JUMP TO CONT.
02500 IF(L.EQ.' ')GO TO 12
02510 IF(L.NE.'F')GO TO 50
02520 MCLEF(NEXT-1)=MCLEF(NEXT-1)+200000000
02530 RETURN
02540 C ABOVE SET NEW FILL POINT.
02600 50 REREAD 33,ML,MLA
02700 CC IF(JJJ)JJK=-1
02800 C TO SET POINT BY NUM(NOT FOR FILLER) NOT NOW IN!
02900 131 IF(M.GE.0)CALL UNPACK(NEXTX,NX,NY,MCLEF)
03100 C FOR RELATIVE POS. CHANGE
03200 X=NX+ML
03300 Y=NY+MLA
03400 GO TO 13
03500 12 CALL RDCUR(NX,NY)
03600 130 X=STPT(FLOAT(NX),RJB)
03700 Y=STPT(FLOAT(NY),CENTR)
03800 13 NX=GTPT(X,RJB)
03900 NY=GTPT(Y,CENTR)
04000 CALL SETCUR(NX,NY,0)
04100 IF(K.EQ.0)GO TO 14
04200 NT=NEXT
04300 L=NT
04600 40 FORMAT(' POINT OK? (Y,N,B,J,F OR C) ',$)
04650 C Y=YES,N=NO,B=BACKUP,J=JUMP,F=START FILL,C=CONTINUE(NULLIFY JUMP)
04700 TYPE 4,L,X,Y
04800 TYPE 40
04900 ACCEPT 3,L
04910 IF(L.EQ.'B')RETURN
05000 IF(L.EQ.'N')GO TO 5
05100 IF(K.NE.'A')GO TO 8
05150 C WHAT IS ABOVE FOR?????
05200 NT=NEXTX
05300 GO TO 7
05400 11 FORMAT(I3,')',2I6,1X$)
05600 CC8 TYPE 19
05700 CC ACCEPT 3,L
05800 CC IF(L.EQ.'B')RETURN
05900 8 A=X
06000 B=Y
06100 K=0
06200 GO TO 12
06300 C NOW ASSUMES → IF NO ← POINT FOUND
06400 14 IF(NX.EQ.SCLEF(NT-2,1).AND.NY.EQ.SCLEF(NT-2,2))NT=NT-1
06500 15 X=A
06600 Y=B
06700 J=J+1
06800 DO 6 L=J,NT+1,-1
06900 6 MCLEF(L)=MCLEF(L-1)
07000 7 LL=0
07100 NX=X
07200 NY=Y
07500 IF(MCLEF(NT).GT.100000000.AND.L.NE.'C')LL=(MCLEF(NT)/100000000)*
07512 1 100000000
07525 IF(L.EQ.'J')LL=100000000
07530 IF(L.EQ.'F')LL=200000000
07600 K=MCLEF(NT)
07700 CALL REPACK(NT,NX,NY,MCLEF)
07900 GO TO 100
08000 CC19 FORMAT(' OTHER POINT? ',$)
08100 3 FORMAT(A1)
08200 33 FORMAT(2I)
08300 4 FORMAT(I4,')',2F6.0)
08400 C NT IS FOR INSERTS
08450 1 IF(J-NEXT)RETURN
08500 DO 10 L=NEXT,J+1
08530 IF(L.EQ.'F')LL=200000000
08600 10 MCLEF(L-1)=MCLEF(L)
08700 J=J-1
08800 100 MCLEF(1)=J
08900 KK=0
09000 IF(MCLEF(2).LT.100000000)MCLEF(2)=MCLEF(2)+100000000
09100 CALL DPYSET(1,IST,4000)
09200 CALL DPYBRT(5)
09300 KK=1
09400 CALL RDRAW(2,MCLEF(1),MCLEF,RJB,CENTR)
09500 CC RETURN
09600 CC2 CALL RDCUR(NX,NY)
09700 END
09800
09900 C*******************************************************
10000 FUNCTION STPT(A,X)
10100 COMMON /RZ/RSZ,IPLT,RJB,CENTR
10200 R=.5
10300 Q=A/RSZ-X
10400 IF(Q)R=-R
10500 STPT=IFIX(Q+R)
10600 RETURN
10700 END
10800
10900 FUNCTION GTPT(A,X)
11000 COMMON /RZ/RSZ,IPLT,RJB,CENTR
11100 GTPT=(A+X)*RSZ
12400 END